home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / jock.zip / TOTSRC11.ZIP / TOTIO2.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  63KB  |  2,361 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.10a                            }
  6.  
  7. Unit totIO2;
  8. {$I TOTFLAGS.INC}
  9.  
  10. {
  11.  Development Notes:
  12.           2/23/91   1.00a    Fixed '-' '+' character validation on
  13.                              RealIOOBJ and FixedRealIOOBJ
  14.           3/29/91   1.00b    Added SetValue to LinkIOOBJ
  15.           4/08/91   1.00c    Problem entering negative exponents in RealIOOBJ
  16.           5/20/91   1.00d    Corrected right justification on IntIOOBJ and RealIOOBJ
  17.                     1.00e    Stopped cursor move when list field not selected
  18.           5/23/91   1.00f    Added reaction to Mouse method 1
  19.           6/11/91   1.00g    Corrected EraseDefault in FixedRealIOOBJ
  20.           7/2/91    1.00h    Added IsNull methods to descendants of SingleLineIOOBJ
  21.           7/23/91   1.00i    Corrected treatment of right-justified strings
  22.  
  23.           9/04/91   1.00j    Added SetNull methods to descendants of SingleLineIOOBJ
  24.          10/03/91   1.00k    Removed #027 dependancy in CharIOOOBJ and FixedRealIOOBJ
  25.          11/19/91   1.00l    Corrected Cursor movement problem with Erase
  26.          02/03/92   1.00m    Changed decimal calc in E notation real fields
  27.          06/23/92   1.00n    Fixed CharOK for Pictures during EraseDefault,
  28.                              added PosCursor to SetValue, and changed
  29.                              vFirstKey logic for null chars.
  30.          09/28/92   1.00o    Corrected EraseDefault setting when mouse use
  31.                              to change field. Updated cursor logic in fixed
  32.                              real when erase default active.
  33.          01/04/93   1.10     Added MoveCursor to Display
  34.          05/03/93   1.10a    Modified LISTIOOBJ.getValue to return 0 (INC file)
  35. }
  36.  
  37. INTERFACE
  38.  
  39. uses DOS, CRT,
  40.      totSYS, totLOOK, totFAST, totSTR, totINPUT, totWIN,
  41.      totIO1, totMSG,  totLINK, totReal, totDATE;
  42.  
  43. CONST
  44.    NumberError: array[1..2] of string[60] =
  45.    (' The number you entered is out of range. ',
  46.    ' Enter a number in the following range: ');
  47.    DateError: array[1..6] of string[60] = 
  48.    (' The date you entered is invalid. ',
  49.     ' Enter a date in the format:',
  50.     ' The date you entered is too early. ',
  51.     ' The earliest acceptable date is: ',
  52.     ' The date you entered is too late. ',
  53.     ' The latest acceptable date is: ');
  54.  
  55. TYPE
  56. pSingleLineIOOBJ = ^SingleLineIOOBJ;
  57. SingleLineIOOBJ = object (VisibleIOOBJ)
  58.    vInsert: boolean;      {is field initially in insert mode}
  59.    vRules: byte;          {erasedefault, jumpiffull..... etc.}
  60.    vFirstKey: boolean;    {has the user entered a key yet}
  61.    vDispChar: char;       {character displayed when key is pressed}
  62.    vPad : Char;           {character used to pad empty part of field}
  63.    {methods ...}
  64.    constructor Init;
  65.    procedure   SetIns(InsOn:boolean);
  66.    procedure   SetRules(Rules:byte);
  67.    procedure   SetDispChar(Ch:char);
  68.    procedure   SetPadChar(Pad:char);
  69.    procedure   SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
  70.    procedure   InsertAction(InsOn:boolean);                     VIRTUAL;
  71.    destructor  Done;                                            VIRTUAL;
  72. end;  {SingleLineIOOBJ}
  73.  
  74. pCharIOOBJ = ^CharIOOBJ;
  75. CharIOOBJ = object (SingleLineIOOBJ)
  76.    vFieldLen: byte;
  77.    vMaxlen : byte;
  78.    vInputStr: StrScreen;
  79.    vCursor: tCursPos;     {cursleft cursright cursprevious}
  80.    vCursorStr: byte;      {position of cursor in string}
  81.    vJust: tJust;          {left center right}
  82.    {methods ...}
  83.    constructor Init(X,Y,FieldLen: byte);
  84.    procedure   SetJust(Just:tJust);
  85.    procedure   SetCursor(Curs: tCursPos);
  86.    procedure   ClearMessage;
  87.    function    IsNull:boolean;
  88.    procedure   SetNull;
  89.    function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
  90.    function    CharOK(var Ch:char): boolean;                    VIRTUAL;
  91.    procedure   Erase;                                           VIRTUAL;
  92.    procedure   CursorEnd;                                       VIRTUAL;
  93.    procedure   CursorHome;                                      VIRTUAL;
  94.    procedure   CursorLeft;                                      VIRTUAL;
  95.    procedure   CursorRight;                                     VIRTUAL;
  96.    procedure   DeleteChar;                                      VIRTUAL;
  97.    procedure   Backspace;                                       VIRTUAL;
  98.    procedure   MoveCursor;                                      VIRTUAL;
  99.    function    ProcessEnter:tAction;                            VIRTUAL;
  100.    procedure   ReDisplay(Status:tStatus);                       VIRTUAL;
  101.    procedure   InitCursor;                                      VIRTUAL; {1.00n}
  102.    procedure   PosCursor;                                       VIRTUAL;
  103.    procedure   Display(Status:tStatus);                         VIRTUAL;
  104.    procedure   ProcessChar(Ch:char);                            VIRTUAL;
  105.    procedure   Activate;                                        VIRTUAL;
  106.    function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
  107.    function    Suspend:boolean;                                 VIRTUAL;
  108.    destructor  Done;                                            VIRTUAL;
  109. end; {object CharIOOBJ}
  110.  
  111. pStringIOOBJ = ^StringIOOBJ;
  112. StringIOOBJ = object (CharIOOBJ)
  113.    vCase: tCase;            {lower upper proper}
  114.    vForceCase: boolean;     {adjust case of characters during input}
  115.    {methods ...}
  116.    constructor Init(X,Y,FieldLen: byte);
  117.    procedure   SetCase(Cas:tCase);
  118.    procedure   SetForceCase(On:boolean);
  119.    procedure   SetValue(Str:string);
  120.    function    GetValue: string;
  121.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  122.    destructor  Done;                                        VIRTUAL;
  123. end; {StringIOOBJ}
  124.  
  125. pPictureIOOBJ = ^PictureIOOBJ;
  126. PictureIOOBJ = object (StringIOOBJ)
  127.    vPicture: string[80];
  128.    vCursorScr: byte;          {position of cursor including format characters}
  129.    vAllowChar: string[40];    {allowable characters}
  130.    vDisAllowChar: string[40]; {disallowed characters}
  131.    {methods ...}
  132.    constructor Init(X,Y: byte;Pic:string);
  133.    function    InputChars: byte;
  134.    function    CursorOffset(InputPos:byte):byte;
  135.    procedure   SetAllowChar(Str:string);
  136.    procedure   SetDisallowChar(Str:string);
  137.    function    GetValue: string;
  138.    function    GetPicValue: string;
  139.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  140.    procedure   Erase;                                       VIRTUAL;
  141.    procedure   CursorEnd;                                   VIRTUAL;
  142.    procedure   CursorHome;                                  VIRTUAL;
  143.    procedure   CursorLeft;                                  VIRTUAL;
  144.    procedure   CursorRight;                                 VIRTUAL;
  145.    procedure   DeleteChar;                                  VIRTUAL;
  146.    procedure   Backspace;                                   VIRTUAL;
  147.    procedure   PosCursor;                                   VIRTUAL;
  148.    procedure   InitCursor;                                  VIRTUAL;
  149.    procedure   MoveCursor;                                  VIRTUAL;
  150.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  151.    destructor  Done;                                        VIRTUAL;
  152. end; {PictureIOOBJ}
  153.  
  154. pLateralIOOBJ = ^LateralIOOBJ;
  155. LateralIOOBJ = object (StringIOOBJ)
  156.    vStartChar: byte;         {the number of the first visible character}
  157.    {methods ...}
  158.    constructor Init(X,Y,FieldLen,MaxLen: byte);
  159.    function    CursorOffset(InputPos:byte):byte;
  160.    procedure   SetNull;
  161.    function    GetValue: string;
  162.    procedure   Erase;                                       VIRTUAL;
  163.    procedure   CursorEnd;                                   VIRTUAL;
  164.    procedure   CursorHome;                                  VIRTUAL;
  165.    procedure   CursorLeft;                                  VIRTUAL;
  166.    procedure   CursorRight;                                 VIRTUAL;
  167.    procedure   DeleteChar;                                  VIRTUAL;
  168.    procedure   Backspace;                                   VIRTUAL;
  169.    procedure   PosCursor;                                   VIRTUAL;
  170.    procedure   InitCursor;                                  VIRTUAL;
  171.    procedure   MoveCursor;                                  VIRTUAL;
  172.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  173.    destructor  Done;                                        VIRTUAL;
  174. end; {LateralIOOBJ}
  175.  
  176. pListIOOBJ = ^ListIOOBJ;
  177. ListIOOBJ = object (MultiLineIOOBJ)
  178.    vTopPick: integer;         {number of first pick in window}
  179.    vTotPicks: integer;        {total number of picks}
  180.    vListAssigned: boolean;    {is data assigned to list}
  181.    vScrollBarOn: boolean;     {is the vertical scrollbar required}
  182.    vBoxBorder: boolean;       {is the list enclosed in a box}
  183.    vActivePick: integer;      {the offset of the active pick from the top}
  184.    vActiveField: boolean;     {is field highlighted}
  185.    {methods ...}
  186.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  187.    procedure   WriteItem(Item:integer; Selected:boolean);
  188.    procedure   DisplayAllPicks;
  189.    procedure   RefreshScrollbar;
  190.    function    HitItem(Y:byte):byte;
  191.    procedure   ScrollJump(Y:byte);
  192.    procedure   ScrollUp;
  193.    procedure   ScrollDown;
  194.    procedure   ScrollPgUp;
  195.    procedure   ScrollPgDn;
  196.    procedure   ScrollEnd;
  197.    procedure   ScrollHome;
  198.    procedure   AdjustMouseKey(var InKey: word;X,Y:byte);
  199.    function    TargetPick(X,Y:byte): longint;
  200.    procedure   MouseChoose(X,Y:byte);
  201.    function    GetValue: integer;
  202.    procedure   SetValue(Hi:integer); {1.00b}
  203.    procedure   ShowItemDetails(HiPick: integer);            VIRTUAL;
  204.    function    SelectPick(InKey:word;X,Y:byte): tAction;    VIRTUAL;
  205.    function    Select(K:word; X,Y:byte):tAction;            VIRTUAL;
  206.    function    ProcessKey(InKey:word;X,Y:byte):tAction;     VIRTUAL;
  207.    procedure   Display(Status:tStatus);                     VIRTUAL;
  208.    function    Suspend:boolean;                             VIRTUAL;
  209.    function    GetString(Pick:integer): string;             VIRTUAL;
  210.    destructor  Done;                                        VIRTUAL;
  211. end; {ListIOOBJ}
  212.  
  213. pArrayIOOBJ = ^ArrayIOOBJ;
  214. ArrayIOOBJ = object (ListIOOBJ)
  215.    vArrayPtr: pointer;
  216.    vStrLength: byte;
  217.    {methods ...}
  218.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  219.    procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
  220.    function    GetString(Pick:integer): string;             VIRTUAL;
  221.    destructor  Done;                                        VIRTUAL;
  222. end; {ArrayIOOBJ}
  223.  
  224. pLinkIOOBJ = ^LinkIOOBJ;
  225. LinkIOOBJ = object (ListIOOBJ)
  226.    vLinkList: ^DLLOBJ;
  227.    {methods ...}
  228.    constructor Init(X1,Y1,width,depth:byte;Title:string);
  229.    procedure   AssignList(var LinkList: DLLOBJ);
  230.    function    GetString(Pick:integer): string;             VIRTUAL;
  231.    destructor  Done;                                        VIRTUAL;
  232. end; {LinkIOOBJ}
  233.  
  234. pIntIOOBJ = ^IntIOOBJ;
  235. IntIOOBJ = object (CharIOOBJ)
  236.    vMin: longint;
  237.    vMax: longint;
  238.    vFmtPtr: pFmtNumberOBJ;
  239.    {methods...}
  240.    constructor Init(X,Y,Len: byte);
  241.    procedure   InitFormat;
  242.    function    FormatPtr: pFmtNumberOBJ;
  243.    function    GetValue: longint;
  244.    procedure   SetValue(Val:longint);
  245.    procedure   SetMinMax(Min,Max: longint);
  246.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  247.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  248.    function    Suspend:boolean;                             VIRTUAL;
  249.    destructor  Done;                                        VIRTUAL;
  250. end; {object IntIOOBJ}
  251.  
  252. pRealIOOBJ = ^RealIOOBJ;
  253. RealIOOBJ = object (CharIOOBJ)
  254.    vMin: Extended;
  255.    vMax: Extended;
  256.    vENotation: boolean;
  257.    vFmtPtr: pFmtNumberOBJ;
  258.    {methods...}
  259.    constructor Init(X,Y,Len:byte);
  260.    procedure   InitFormat;
  261.    function    FormatPtr: pFmtNumberOBJ;
  262.    function    GetValue: extended;
  263.    procedure   SetMinMax(Min,Max:extended);
  264.    procedure   SetValue(Val:extended);
  265.    procedure   SetENotation(On:Boolean);
  266.    function    CharOK(var Ch:char):boolean;                 VIRTUAL;
  267.    procedure   ReDisplay(Status:tStatus);                   VIRTUAL;
  268.    function    Suspend:boolean;                             VIRTUAL;
  269.    destructor  Done;                                        VIRTUAL;
  270. end; {RealIOOBJ}
  271.  
  272. pFixedRealIOOBJ = ^FixedRealIOOBJ;
  273. FixedRealIOOBJ = object (SingleLineIOOBJ)
  274.    vMin: Extended;
  275.    vMax: Extended;
  276.    vDP: byte;
  277.    vWholeP: byte;
  278.    vMaxlen : byte;
  279.    vCursorPos: byte;
  280.    vWholeStr: StrVisible;
  281.    vDPStr: string[20]; {max significance of Turbo reals}
  282.    vFmtPtr: pFmtNumberOBJ;
  283.    {methods...}
  284.    constructor Init(X,Y,Whole,DP:byte);
  285.    procedure   InitFormat;
  286.    function    FormatPtr: pFmtNumberOBJ;
  287.    function    IsNull:boolean;
  288.    procedure   SetNull;
  289.    procedure   Erase;
  290.    procedure   CursorEnd;
  291.    procedure   CursorHome;
  292.    procedure   CursorLeft;
  293.    procedure   CursorRight;
  294.    procedure   DeleteChar;
  295.    procedure   Backspace;
  296.    function    GetValue: extended;
  297.    procedure   SetMinMax(Min,Max:extended);
  298.    procedure   SetValue(Val:extended);
  299.    procedure   ProcessChar(Ch:char);
  300.    function    ProcessEnter:tAction;
  301.    procedure   Condense;
  302.    procedure   PeriodHit;
  303.    procedure   PlusHit;
  304.    procedure   MinusHit;
  305.    procedure   MoveCursor;
  306.    procedure   Display(Status:tStatus);                         VIRTUAL;
  307.    function    ProcessKey(InKey:word;X,Y:byte):tAction;         VIRTUAL;
  308.    procedure   Activate;                                        VIRTUAL;
  309.    function    Select(K:word; X,Y:byte): tAction;               VIRTUAL;
  310.    function    Suspend:boolean;                                 VIRTUAL;
  311.    destructor  Done;                                            VIRTUAL;
  312. end; {FixedRealIOOBJ}
  313.  
  314. pDateIOOBJ = ^DateIOOBJ;
  315. DateIOOBJ = object (PictureIOOBJ)
  316.    vDateFmt: tdate;
  317.    vMin: longint;
  318.    vMax: longint;
  319.    {methods...}
  320.    constructor Init(X,Y:byte;DateFmt:tDate);
  321.    procedure   SetMinMax(Min,Max:longint);
  322.    procedure   SetValue(Date:longint);
  323.    function    GetValue: longint;
  324.    function    Suspend:boolean;                                 VIRTUAL;
  325.    destructor  Done;                                            VIRTUAL;
  326. end; {DateIOOBJ}
  327.  
  328. pHexIOOBJ = ^HexIOOBJ;
  329. HexIOOBJ = object (PictureIOOBJ)
  330.    vMin: longint;
  331.    vMax: longint;
  332.    {methods...}
  333.    constructor Init(X,Y,Len:byte);
  334.    procedure   SetMinMax(Min,Max:longint);
  335.    procedure   SetValue(Val:longint);
  336.    function    GetValue: longint;
  337.    function    Suspend:boolean;                                 VIRTUAL;
  338.    destructor  Done;                                            VIRTUAL;
  339. end; {HexIOOBJ}
  340.  
  341. procedure IO2Init;
  342.  
  343. var
  344.   FmtNumberTOT: FmtNumberOBJ;
  345.   
  346. IMPLEMENTATION
  347.  
  348. procedure ValidationMessage(Line1,Line2,Line3,Line4:string);
  349. {}
  350. var
  351.    Msg: MessageOBJ;
  352. begin
  353.    with Msg do
  354.    begin
  355.       Init(2,' Invalid Input! ');
  356.       AddLine('');
  357.       AddLine(' '+Line1);
  358.       AddLine(' '+Line2);
  359.       AddLine(' '+Line3);
  360.       AddLine(' '+Line4);
  361.       AddLine('');
  362.       Show;
  363.       Done;
  364.    end; {with}
  365. end; {ValidationMessage}
  366. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  367. {                                                      }
  368. {     S i n g l e L i n e I O O B J   M E T H O D S    }
  369. {                                                      }
  370. {||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  371. constructor SingleLineIOOBJ.Init;
  372. {}
  373. begin
  374.    VisibleIOOBJ.Init;
  375.    vDispChar := ' ';
  376.    vInsert := IOTOT^.InputIns;
  377.    vRules := IOTOT^.InputRules;
  378.    vPad := IOTOT^.InputPad;
  379. end; {SingleLineIOOBJ.Init}
  380.  
  381. procedure SingleLineIOOBJ.InsertAction(InsOn:boolean);
  382. {}
  383. begin
  384.    if InsOn then
  385.       Screen.CursHalf
  386.    else
  387.       Screen.CursOn;
  388. end; {SingleLineIOOBJ.ChangeMode}
  389.  
  390. procedure SingleLineIOOBJ.SetIns(InsOn:boolean);
  391. {}
  392. begin
  393.    vInsert := InsOn;
  394. end; {SingleLineIOOBJ.SetIns}
  395.  
  396. procedure SingleLineIOOBJ.SetRules(Rules:byte);
  397. {}
  398. begin
  399.    vRules := Rules;
  400. end; {SetRules}
  401.  
  402. procedure SingleLineIOOBJ.SetPadChar(Pad:char);
  403. {}
  404. begin
  405.    vPad := Pad;
  406. end; {SingleLineIOOBJ.SetPadChar}
  407.  
  408. procedure SingleLineIOOBJ.SetFieldAttr(Status:tStatus; var Attr:byte; var Str:string);
  409. {}
  410. begin
  411.    case Status of
  412.    HiStatus:    Attr := IOTOT^.FieldCol(2);
  413.    Norm:  Attr := IOTOT^.FieldCol(1);
  414.    Off:   Attr := IOTOT^.FieldCol(4);
  415.    end; {case}
  416.    if (vDispChar <> ' ') then
  417.       Str := Replicate(length(Str),vDispChar);
  418. end; {SingleLineIOOBJ.SetFieldAttr}
  419.  
  420. procedure SingleLineIOOBJ.SetDispChar(Ch:char);
  421. {}
  422. begin
  423.    vDispChar := Ch;
  424. end; {SingleLineIOOBJ.SetDispChar}
  425.  
  426. destructor SingleLineIOOBJ.Done;
  427. {}
  428. begin
  429.    VisibleIOOBJ.Done;
  430. end; {SingleLineIOOBJ.Done}
  431. {||||||||||||||||||||||||||||||||||||||||||}
  432. {                                          }
  433. {     C h a r I O O B J   M E T H O D S    }
  434. {                                          }
  435. {||||||||||||||||||||||||||||||||||||||||||}
  436. constructor CharIOOBJ.Init(X,Y,FieldLen: byte);
  437. {}
  438. var
  439.   W : byte;
  440. begin
  441.    SingleLineIOOBJ.Init;
  442.    vInputStr := '';
  443.    vCursor := IOTOT^.InputCursorLoc;
  444.    vCursorStr := 1;
  445.    vJust := IOTOT^.InputJust;
  446. {$IFDEF CHECK}
  447.    W := Monitor^.Width;
  448.    if X > W then
  449.       vBoundary.X1 := 1
  450.    else
  451.       vBoundary.X1 := X;
  452.    vBoundary.Y1 := Y;
  453.    vBoundary.Y2 := vBoundary.Y1;
  454.    if pred(vBoundary.X1 + FieldLen) > W then
  455.       vFieldLen := succ(W - vBoundary.X1)
  456.    else
  457.       vFieldLen := FieldLen;
  458.    vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
  459. {$ELSE}
  460.    vBoundary.X1 := X;
  461.    vBoundary.X2 := pred(vBoundary.X1 + FieldLen);
  462.    vBoundary.Y1 := Y;
  463.    vBoundary.Y2 := vBoundary.Y1;
  464.    vFieldlen := FieldLen;
  465. {$ENDIF}
  466.    vMaxlen := vFieldLen;
  467. end; {cons CharIOOBJ.Init}
  468.  
  469. function CharIOOBJ.IsNull:boolean; {1.00h}
  470. {}
  471. begin
  472.    IsNull := vInputStr = '';
  473. end; {CharIOOBJ.IsNull}
  474.  
  475. procedure CharIOOBJ.SetNull;   {1.00j}
  476. {}
  477. begin
  478.    vInputStr := '';
  479.    vCursorStr := 1;
  480. end; {CharIOOBJ.SetNull}
  481.  
  482. procedure CharIOOBJ.SetCursor(Curs:tCursPos);
  483. {}
  484. begin
  485.    vCursor := Curs;
  486. end; {CharIOOBJ.SetCurs}
  487.  
  488. procedure CharIOOBJ.SetJust(Just:tJust);
  489. {}
  490. begin
  491.    vJust := Just;
  492. end; {CharIOOBJ.SetJust}
  493.  
  494. procedure CharIOOBJ.CursorHome;
  495. {}
  496. begin
  497.    vCursorStr := 1;
  498.    ReDisplay(HiStatus);        {1.00i}
  499. end; {CharIOOBJ.CursorHome}
  500.  
  501. procedure CharIOOBJ.CursorEnd;
  502. {}
  503. begin
  504.    if (vCursorStr <= length(vInputStr)) then
  505.       vCursorStr := succ(length(vInputStr));
  506. end; {CharIOOBJ.CursorEnd}
  507.  
  508. procedure CharIOOBJ.CursorLeft;
  509. {}
  510. begin
  511.    if vCursorStr > 1 then
  512.       dec(vCursorStr);
  513. end; {CharIOOBJ.CursorLeft}
  514.  
  515. procedure CharIOOBJ.CursorRight;
  516. {}
  517. begin
  518.    if (vCursorStr <= length(vInputStr)) then
  519.       if (vCursorStr <= vMaxLen) then
  520.          inc(vCursorStr);
  521. end; {CharIOOBJ.CursorRight}
  522.  
  523. procedure CharIOOBJ.Erase;
  524. {}
  525. begin
  526.    vInputStr := '';
  527.    vCursorStr := 1;
  528.    Display(HiStatus);
  529.    MoveCursor;                        {1.00l}
  530. end; {CharIOOBJ.Erase}
  531.  
  532. procedure CharIOOBJ.DeleteChar;
  533. {}
  534. begin
  535.   delete(vInputStr,vCursorStr,1);
  536.   ReDisplay(HiStatus);                {1.00i}
  537. end; {CharIOOBJ.DeleteChar}
  538.  
  539. procedure CharIOOBJ.BackSpace;
  540. {}
  541. begin
  542.    if vCursorStr > 1 then
  543.    begin
  544.       CursorLeft;
  545.       DeleteChar;
  546.       ReDisplay(HiStatus)
  547.    end;
  548. end; {CharIOOBJ.BackSpace}
  549.  
  550. function CharIOOBJ.ProcessEnter:tAction;
  551. {}
  552. begin
  553.    ProcessEnter := Enter;
  554. end; {CharIOOBJ.ProcessEnter}
  555.  
  556. procedure CharIOOBJ.MoveCursor;
  557. {}
  558. begin
  559.    Screen.GotoXY(pred(vBoundary.X1)+vCursorStr,vBoundary.Y1);
  560. end; {CharIOOBJ.MoveCursor}
  561.  
  562. procedure CharIOOBJ.InitCursor;
  563. {}
  564. begin
  565.    if vCursor = CursLeft then
  566.       vCursorStr := 1
  567.    else
  568.       vCursorStr := succ(length(vInputStr));
  569. end; {CharIOOBJ.InitCursor}
  570.  
  571. procedure CharIOOBJ.PosCursor;
  572. {}
  573. begin
  574.    case vCursor of
  575.       CursLeft:  vCursorStr := 1;
  576.       CursRight: vCursorStr := succ(length(vInputStr));
  577.       CursPrev:  {do nothing};
  578.    end; {case}
  579. end; {CharIOOBJ.PosCursor}
  580.  
  581. procedure CharIOOBJ.ReDisplay(Status:tStatus);
  582. {abstract}
  583. begin end;
  584.  
  585. procedure CharIOOBJ.Display(Status:tStatus);
  586. {}
  587. begin
  588.    PosCursor;
  589.    if Status = hiStatus then
  590.       MoveCursor; {1.10}
  591.    ReDisplay(Status);
  592. end; {CharIOOBJ.Display}
  593.  
  594. function CharIOOBJ.CharOK(var Ch:char): boolean;
  595. {}
  596. begin
  597.    CharOK := true;
  598. end; {CharIOOBJ.CharOK}
  599.  
  600. procedure CharIOOBJ.ProcessChar(Ch:char);
  601. {}
  602.  
  603.    procedure EraseOld;
  604.    {}
  605.    begin
  606.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
  607.          Erase;
  608.    end; {EraseOld}
  609.  
  610. begin
  611.    if ( ( (vInsert and (length(vInputStr) >= vMaxlen))
  612.           or
  613.           (vCursorStr > vMaxLen)
  614.         )
  615.         and
  616.         ((vFirstKey and ((vRules and EraseDefault) = EraseDefault))=false)
  617.       ) then
  618.       Ding
  619.    else
  620.    begin
  621.       if CharOK(Ch) then
  622.          EraseOld
  623.       else
  624.       begin
  625.          Ding;
  626.          exit
  627.       end;
  628.       if not vInsert then
  629.          Delete(vInputStr,vCursorStr,1);
  630.       insert(Ch,vInputStr,vCursorStr);
  631.       CursorRight;
  632.       ReDisplay(HiStatus);
  633.    end;
  634. end; {CharIOOBJ.ProcessChar}
  635.  
  636. function CharIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  637. {}
  638. begin
  639.    Case InKey of
  640.       8: BackSpace;
  641.       288: Erase;  {Alt-D}
  642.       339: DeleteChar;
  643.       327: CursorHome;
  644.       335: CursorEnd;
  645.       331: CursorLeft;
  646.       333: CursorRight;
  647.       338: begin
  648.               vInsert := not vInsert;
  649.               InsertAction(vInsert);
  650.            end;
  651.       32..255: ProcessChar(chr(InKey));    {characters}
  652.    end; {case}
  653.    case InKey of
  654.       523,13: ProcessKey := ProcessEnter;
  655.       (* 1.00k
  656.       27: ProcessKey := Escaped;
  657.       *)
  658.       else 
  659.       begin
  660.          if  ((vRules and JumpIfFull) = JumpIfFull)
  661.          and (length(vInputStr) >= vMaxlen)
  662.          and ( (Inkey >= 32) and (InKey <= 255)) 
  663.          and (vCursorStr > vMaxLen) then
  664.             ProcessKey := NextField
  665.          else
  666.             ProcessKey := None;
  667.       end;
  668.    end;
  669.    if (Inkey > 0) and (Inkey < 255) then  {1.00n}
  670.       vFirstKey := false;
  671.    MoveCursor;
  672. end; {CharIOOBJ.ProcessKey}
  673.  
  674. procedure CharIOOBJ.Activate;
  675. {}
  676. var
  677.    Action: tAction;
  678. begin
  679.    repeat
  680.       Action := Select(0,0,0);
  681.       Display(HiStatus);
  682.       WriteLabel(HiStatus);
  683.       with Key do 
  684.       repeat
  685.          GetInput;
  686.          if LastKey = 27 then
  687.             Action := Escaped
  688.          else
  689.             Action := ProcessKey(LastKey,LastX,LastY);
  690.       until Action in [Finished,Escaped,Enter];
  691.    until (Action = Escaped) or Suspend;
  692. end; {CharIOOBJ.Activate}
  693.  
  694. function CharIOOBJ.Select(K:word; X,Y:byte): tAction;
  695. {}
  696. begin
  697.    Display(HiStatus);
  698.    WriteLabel(HiStatus);
  699.    WriteMessage;
  700.    vFirstKey := true;
  701.    InsertAction(vInsert);
  702.    PosCursor;
  703.    MoveCursor;
  704.    Select := None;
  705. end; {CharIOOBJ.Select}
  706.  
  707. procedure CharIOOBJ.ClearMessage;
  708. {}
  709. var Col,L: byte;
  710. begin
  711.    if vMsgPtr <> Nil then   {clear the message}
  712.    begin
  713.       move(vMsgPtr^,L,1);
  714.       if L > 0 then
  715.       begin
  716.          Col := IOTOT^.MessageCol;
  717.          if Col = 0 then
  718.             Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
  719.          else
  720.             Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
  721.       end;
  722.    end;
  723. end; {CharIOOBJ.ClearMessage}
  724.  
  725. function CharIOOBJ.Suspend:boolean;
  726. {}
  727. begin
  728.    ReDisplay(Norm);
  729.    WriteLabel(Norm);
  730.    ClearMessage;
  731.    Suspend := true;
  732. end; {CharIOOBJ.Suspend}
  733.  
  734. destructor CharIOOBJ.Done;
  735. {}
  736. begin
  737.    SingleLineIOOBJ.Done;
  738. end; {CharIOOBJ.Done}
  739.  
  740. {||||||||||||||||||||||||||||||||||||||||||||||}
  741. {                                              }
  742. {     S t r F i e l d O B J   M E T H O D S    }
  743. {                                              }
  744. {||||||||||||||||||||||||||||||||||||||||||||||}
  745. constructor StringIOOBJ.Init(X,Y,FieldLen: byte);
  746. {}
  747. begin
  748.    CharIOOBJ.Init(X,Y,FieldLen);
  749.    vCase := IOTOT^.InputCase;
  750.    vForceCase := IOTOT^.InputForceCase;
  751. end; {StringIOOBJ.Init}
  752.  
  753. procedure StringIOOBJ.SetValue(Str:string);
  754. {}
  755. begin
  756.    vInputStr := Str;
  757.    if vCursorStr > succ(length(Str)) then
  758.       vCursorStr :=  succ(length(Str));
  759.    InitCursor;
  760. end; {StringIOOBJ.SetValue}
  761.  
  762. procedure StringIOOBJ.SetCase(Cas:tCase);
  763. {}
  764. begin
  765.    vCase := Cas;
  766. end; {StringIOOBJ.SetCase}
  767.  
  768. procedure StringIOOBJ.SetForceCase(On:boolean);
  769. {}
  770. begin
  771.    vForceCase := On;
  772. end; {StringIOOBJ.SetForceCase}
  773.  
  774. function StringIOOBJ.GetValue: string;
  775. {}
  776. begin
  777.    GetValue := vInputStr;
  778. end; {StringIOOBJ.GetValue}
  779.  
  780. procedure StringIOOBJ.ReDisplay(Status:tStatus);
  781. {}
  782. var
  783.   A: byte;
  784.   AdjStr: String;
  785. begin
  786.    if (Status <> HiStatus)
  787.    or ((Status = HiStatus) and vForceCase) then
  788.       vInputStr := AdjCase(vCase,vInputStr);
  789.    if (vDispChar = ' ') then
  790.       AdjStr := vInputStr
  791.    else
  792.       AdjStr := Replicate(length(vInputStr),vDispChar);
  793.    if Status = HiStatus then
  794.    begin
  795.      SetFieldAttr(Status,A,AdjStr);
  796.      Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(AdjStr,vFieldlen,vPad));
  797.    end
  798.    else
  799.    begin
  800.       SetFieldAttr(Status,A,AdjStr);  {was norm}
  801.       AdjStr := Pad(vJust,AdjStr,vFieldLen,vPad);
  802.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
  803.    end;
  804. end; {StringIOOBJ.ReDisplay}
  805.  
  806. destructor StringIOOBJ.Done;
  807. {}
  808. begin
  809.    CharIOOBJ.Done;
  810. end; {StringIOOBJ.Done}
  811. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  812. {                                                    }
  813. {     P i c S t r F i e l d O B J   M E T H O D S    }
  814. {                                                    }
  815. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  816. constructor PictureIOOBJ.Init(X,Y: byte;Pic:string);
  817. {}
  818. begin
  819.    StringIOOBJ.Init(X,Y,length(Pic));
  820.    vPicture := Pic;
  821.    vFieldLen := InputChars;
  822.    vMaxlen := vFieldlen;
  823.    vAllowChar := '';
  824.    vDisAllowChar := '';
  825.    SetIns(IOTOT^.InputIns);
  826. end; {PictureIOOBJ.Init}
  827.  
  828. function PictureIOOBJ.InputChars: byte;
  829. {}
  830. var
  831.   Counter : byte;
  832.   I : integer;
  833. begin
  834.   Counter := 0;
  835.   for I := 1 to length(vPicture) do
  836.       if vPicture[I] in FmtChars then
  837.          Inc(Counter);
  838.   InputChars := counter;
  839. end; {PictureIOOBJ.InputChars}
  840.  
  841. procedure PictureIOOBJ.SetAllowChar(Str:string);
  842. {}
  843. begin
  844.    vAllowChar := Str;
  845. end; {PictureIOOBJ.SetAllowChar}
  846.  
  847. procedure PictureIOOBJ.SetDisAllowChar(Str:string);
  848. {}
  849. begin
  850.    vDisAllowChar := Str;
  851. end; {PictureIOOBJ.SetDisAllowChar}
  852.  
  853. procedure PictureIOOBJ.ReDisplay(Status:tStatus);
  854. {}
  855. var
  856.   A,B,Len: byte;
  857.   Counter,I: integer;
  858.   AdjStr,
  859.   TempStr : string;
  860. begin
  861.    AdjStr := vInputStr;
  862.    SetFieldAttr(Status,A,AdjStr);
  863.    if Status <> HiStatus Then
  864.    begin
  865.       vInputStr := AdjCase(vCase,vInputStr);
  866.       TempStr := PicFormat(AdjStr,vPicture,vPad);
  867.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
  868.    end
  869.    else
  870.    begin
  871.      B := IOTot^.FieldCol(3);
  872.      Counter := 0;
  873.      Len := length(vInputStr);
  874.      for I := 1 to length(vPicture) do
  875.      begin
  876.         if (vPicture[I] in FmtChars) then
  877.         begin
  878.            inc(Counter);
  879.            if Counter <= Len then
  880.               Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vInputStr[Counter])
  881.            else
  882.               Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,A,vPad);
  883.         end
  884.         else
  885.            Screen.WriteAt(vBoundary.X1 + pred(I),vBoundary.Y1,B,vPicture[I]);
  886.      end;
  887.    end;
  888. end; {PictureIOOBJ.ReDisplay}
  889.  
  890. function PictureIOOBJ.CursorOffset(InputPos:byte):byte;
  891. {}
  892. var
  893.    Counter: byte;
  894.    CharPos: byte;
  895.    L : byte;
  896. begin
  897.    Counter := 0;
  898.    CharPos := 0;
  899.    L := length(vPicture);
  900.    repeat
  901.       inc(Counter);
  902.       if vPicture[Counter] in FmtChars then
  903.          inc(CharPos);
  904.    until (CharPos = InputPos) or (Counter > L);
  905.    CursorOffset := Counter + pred(vBoundary.X1);
  906. end; {PictureIOOBJ.CursorOffset}
  907.  
  908. procedure PictureIOOBJ.InitCursor;
  909. {}
  910. begin
  911.    StringIOOBJ.InitCursor;
  912.    vCursorScr := CursorOffset(vCursorStr);
  913. end; {Picture.InitCursor}
  914.  
  915. procedure PictureIOOBJ.PosCursor;
  916. {}
  917. begin
  918.    StringIOOBJ.PosCursor;
  919.    vCursorScr := CursorOffset(vCursorStr);
  920. end; {PictureIOOBJ.PosCursor}
  921.  
  922. procedure PictureIOOBJ.Erase;
  923. {}
  924. begin
  925.    vInputStr := '';
  926.    vCursorStr := 1;
  927.    PosCursor;
  928.    Display(HiStatus);
  929. end; {PictureIOOBJ.Erase}
  930.  
  931. procedure PictureIOOBJ.CursorHome;
  932. {}
  933. begin
  934.    vCursorStr := 1;
  935.    vCursorScr := CursorOffset(vCursorStr);
  936. end; {PictureIOOBJ.CursorHome}
  937.  
  938. procedure PictureIOOBJ.CursorEnd;
  939. {}
  940. begin
  941.    if (vCursorStr <= length(vInputStr)) then
  942.    begin
  943.       vCursorStr := succ(length(vInputStr));
  944.       vCursorScr := CursorOffset(vCursorStr);
  945.    end;
  946. end; {PictureIOOBJ.CursorEnd}
  947.  
  948. procedure PictureIOOBJ.CursorLeft;
  949. {}
  950. begin
  951.    if vCursorStr > 1 then
  952.    begin
  953.       dec(vCursorStr);
  954.       Repeat
  955.          dec(vCursorScr);
  956.       Until vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars;
  957.    end;
  958. end; {PictureIOOBJ.CursorLeft}
  959.  
  960. procedure PictureIOOBJ.CursorRight;
  961. {}
  962. begin
  963.    if (vCursorStr <= length(vInputStr)) then
  964.    begin
  965.       Inc(vCursorStr);
  966.       Repeat
  967.          Inc(vCursorScr);
  968.       Until (succ(vCursorScr-vBoundary.X1) > length(vPicture))
  969.          or (vPicture[succ(vCursorScr - vBoundary.X1)] in FmtChars);
  970.    end;
  971. end; {PictureIOOBJ.CursorRight}
  972.  
  973. procedure PictureIOOBJ.DeleteChar;
  974. {}
  975. begin
  976.   delete(vInputStr,vCursorStr,1);
  977.   ReDisplay(HiStatus);
  978. end; {PictureIOOBJ.DeleteChar}
  979.  
  980. procedure PictureIOOBJ.BackSpace;
  981. {}
  982. begin
  983.    if vCursorStr > 1 then
  984.    begin
  985.       CursorLeft;
  986.       DeleteChar;
  987.       ReDisplay(HiStatus)
  988.    end;
  989. end; {PictureIOOBJ.BackSpace}
  990.  
  991. function PictureIOOBJ.CharOK(var Ch:char):boolean;
  992. {}
  993. var
  994.    PicChar : char;
  995. begin
  996.    if ((vAllowChar <> '') and (pos(Ch,vAllowChar) = 0))
  997.    or ((vDisAllowChar <> '') and (pos(Ch,vDisAllowChar) > 0)) then
  998.       CharOK := false
  999.    else
  1000.    begin
  1001.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then {1.00n}
  1002.          PicChar := vPicture[CursorOffset(1)-pred(vBoundary.X1)]
  1003.       else
  1004.          PicChar := vPicture[succ(vCursorScr - vBoundary.X1)];
  1005.       if PicChar = '!' then
  1006.          Ch := upcase(Ch);
  1007.       CharOK :=  ((Ch in ['0'..'9',FmtNumberTOT.GetDecimal,'-']) and (PicChar = '#'))
  1008.               or ((AlphabetTOT^.IsLetter(ord(Ch)) or AlphabetTOT^.IsPunctuation(ord(Ch))) and (PicChar = '@'))
  1009.               or (PicChar in ['*','!']);
  1010.       end;
  1011. end; {PictureIOOBJ.CharOK}
  1012.  
  1013. procedure PictureIOOBJ.MoveCursor;
  1014. {}
  1015. begin
  1016.    Screen.GotoXY(vCursorScr,vBoundary.Y1);
  1017. end; {PictureIOOBJ.MoveCursor}
  1018.  
  1019. function PictureIOOBJ.GetValue:string;
  1020. {}
  1021. begin
  1022.    GetValue := vInputStr;
  1023. end; {PictureIOOBJ.GetValue}
  1024.  
  1025. function PictureIOOBJ.GetPicValue:string;
  1026. {}
  1027. begin
  1028.    GetPicValue := PicFormat(vInputStr,vPicture,' ');
  1029. end; {PictureIOOBJ.GetPicValue}
  1030.  
  1031. destructor PictureIOOBJ.Done;
  1032. {}
  1033. begin
  1034.    CharIOOBJ.Done;
  1035. end; {PictureIOOBJ.Done}
  1036.  
  1037. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1038. {                                                }
  1039. {     L a t e r a l I O O B J   M E T H O D S    }
  1040. {                                                }
  1041. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1042.  
  1043. constructor LateralIOOBJ.Init(X,Y,FieldLen,MaxLen: byte);
  1044. {}
  1045. begin
  1046.    StringIOOBJ.Init(X,Y,FieldLen);
  1047.    vStartChar := 1;
  1048. {$IFDEF CHECK}
  1049.    if Maxlen < vFieldlen then
  1050.       vMaxlen := vFieldLen
  1051.    else
  1052.       vMaxLen := MaxLen;
  1053. {$ELSE}
  1054.    vMaxLen := MaxLen;
  1055. {$ENDIF}
  1056. end; {LateralIOOBJ.Init}
  1057.  
  1058. procedure LateralIOOBJ.ReDisplay(Status:tStatus);
  1059. {}
  1060. var
  1061.   A: byte;
  1062.   AdjStr,
  1063.   TempStr : string;
  1064. begin
  1065.    if (Status <> HiStatus)
  1066.    or ((Status = HiStatus) and vForceCase) then
  1067.       vInputStr := AdjCase(vCase,vInputStr);
  1068.    case Status of
  1069.      HiStatus:    A:= IOTOT^.FieldCol(2);
  1070.      Norm:  A:= IOTOT^.FieldCol(1);
  1071.      Off:   A:= IOTOT^.FieldCol(4);
  1072.    end; {case}
  1073.    if (vDispChar = ' ') then
  1074.       AdjStr := vInputStr
  1075.    else
  1076.       AdjStr := Replicate(length(vInputStr),vDispChar);
  1077.    if Status <> HiStatus then
  1078.       vInputStr := AdjCase(vCase,vInputStr);
  1079.    TempStr := TruncFormat(AdjStr,vStartChar,vFieldLen,vPad);
  1080.    Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,TempStr);
  1081. end; {LateralIOOBJ.ReDisplay}
  1082.  
  1083. function LateralIOOBJ.CursorOffset(InputPos:byte):byte;
  1084. {}
  1085. begin
  1086.    CursorOffset := succ(InputPos - vStartChar)
  1087. end; {LateralIOOBJ.CursorOffset}
  1088.  
  1089. procedure LateralIOOBJ.InitCursor;
  1090. {}
  1091. begin
  1092.    if vCursor = CursLeft then
  1093.    begin
  1094.       vCursorStr := 1;
  1095.       vStartChar := 1;
  1096.    end
  1097.    else
  1098.    begin
  1099.       vCursorStr := succ(length(vInputStr));
  1100.       if vCursorStr - vStartChar > vFieldLen then
  1101.          vStartChar := vCursorStr - vFieldLen;
  1102.    end;
  1103. end; {LateralIOOBJ.InitCursor}
  1104.  
  1105. procedure LateralIOOBJ.PosCursor;
  1106. {}
  1107. begin
  1108.    case vCursor of
  1109.       CursLeft:  begin
  1110.                     vCursorStr := 1;
  1111.                     vStartChar := 1;
  1112.                  end;
  1113.       CursRight: begin
  1114.                     vCursorStr := succ(length(vInputStr));
  1115.                     if vCursorStr - vStartChar > vFieldLen then
  1116.                        vStartChar := vCursorStr - vFieldLen;
  1117.                  end;
  1118.       CursPrev:  {do nothing};
  1119.    end; {case}
  1120. end; {LateralIOOBJ.PosCursor}
  1121.  
  1122. procedure LateralIOOBJ.CursorHome;
  1123. {}
  1124. begin
  1125.    vCursorStr := 1;
  1126.    if vStartChar <> 1 then
  1127.    begin
  1128.       vStartChar := 1;
  1129.       ReDisplay(HiStatus);
  1130.    end;
  1131. end; {LateralIOOBJ.CursorHome}
  1132.  
  1133. procedure LateralIOOBJ.CursorEnd;
  1134. {}
  1135. begin
  1136.    if (vCursorStr <= length(vInputStr)) then
  1137.    begin
  1138.       vCursorStr := succ(length(vInputStr));
  1139.       if (vCursorStr - vStartChar) > vFieldLen then
  1140.       begin
  1141.          vStartChar := vCursorStr - vFieldLen;
  1142.          ReDisplay(HiStatus);
  1143.       end;
  1144.    end;
  1145. end; {LateralIOOBJ.CursorEnd}
  1146.  
  1147. procedure LateralIOOBJ.CursorLeft;
  1148. {}
  1149. begin
  1150.    if vCursorStr > 1 then
  1151.    begin
  1152.       if vCursorStr = vStartChar then
  1153.       begin
  1154.          dec(vStartChar);
  1155.          dec(vCursorStr);
  1156.          ReDisplay(HiStatus)
  1157.       end
  1158.       else
  1159.          dec(vCursorStr);
  1160.    end;
  1161. end; {LateralIOOBJ.CursorLeft}
  1162.  
  1163. procedure LateralIOOBJ.CursorRight;
  1164. {}
  1165. begin
  1166.    if (vCursorStr <= length(vInputStr)) then
  1167.    begin
  1168.       if vCursorStr - vStartChar = vFieldLen then
  1169.       begin
  1170.          inc(vStartChar);
  1171.          inc(vCursorStr);
  1172.          ReDisplay(HiStatus);
  1173.       end
  1174.       else
  1175.          inc(vCursorStr);
  1176.    end;
  1177. end; {LateralIOOBJ.CursorRight}
  1178.  
  1179. procedure LateralIOOBJ.SetNull;   {1.00j}
  1180. {}
  1181. begin
  1182.    StringIOOBJ.SetNull;
  1183.    vStartChar := 1;
  1184. end; {LateralIOOBJ.SetNull}
  1185.  
  1186. procedure LateralIOOBJ.Erase;
  1187. {}
  1188. begin
  1189.    SetNull;
  1190.    PosCursor;
  1191.    Display(HiStatus);
  1192. end; {LateralIOOBJ.Erase}
  1193.  
  1194. procedure LateralIOOBJ.DeleteChar;
  1195. {}
  1196. begin
  1197.   delete(vInputStr,vCursorStr,1);
  1198.   ReDisplay(HiStatus);
  1199. end; {LateralIOOBJ.DeleteChar}
  1200.  
  1201. procedure LateralIOOBJ.BackSpace;
  1202. {}
  1203. begin
  1204.    if vCursorStr > 1 then
  1205.    begin
  1206.       CursorLeft;
  1207.       DeleteChar;
  1208.       ReDisplay(HiStatus)
  1209.    end;
  1210. end; {LateralIOOBJ.BackSpace}
  1211.  
  1212. procedure LateralIOOBJ.MoveCursor;
  1213. {}
  1214. begin
  1215.    Screen.GotoXY(pred(vBoundary.X1)+vCursorStr - pred(vStartChar),vBoundary.Y1);
  1216. end; {LateralIOOBJ.MoveCursor}
  1217.  
  1218. function LateralIOOBJ.GetValue:string;
  1219. {}
  1220. begin
  1221.    GetValue := vInputStr;
  1222. end; {LateralIOOBJ.GetValue}
  1223.  
  1224. destructor LateralIOOBJ.Done;
  1225. {}
  1226. begin
  1227.    CharIOOBJ.Done;
  1228. end; {StringFieldOBJ.Done}
  1229. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1230. {                                                }
  1231. {     L i s t F i e l d O B J   M E T H O D S    }
  1232. {                                                }
  1233. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1234. {$I totIO2.INC}
  1235. {||||||||||||||||||||||||||||||||||||||||||||||||||}
  1236. {                                                  }
  1237. {     A r r a y F i e l d O B J   M E T H O D S    }
  1238. {                                                  }
  1239. {||||||||||||||||||||||||||||||||||||||||||||||||||}
  1240.  
  1241. constructor ArrayIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1242. {}
  1243. begin
  1244.    ListIOOBJ.Init(X1,Y1,width,depth,Title);
  1245. end; {ArrayIOOBJ.Init}
  1246.  
  1247. procedure ArrayIOOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
  1248. {}
  1249. begin
  1250.    vArrayPtr := @StrArray;
  1251.    vStrLength := StrLength;
  1252.    vTotPicks := Total;
  1253.    vListAssigned := true;
  1254. end; {ArrayIOOBJ.AssignList}
  1255.  
  1256. function ArrayIOOBJ.GetString(Pick:integer): string;
  1257. {}
  1258. var
  1259.   W : word;
  1260.   TempStr : String;
  1261.   ArrayOffset: word;
  1262. begin
  1263.    if (Pick > 0) and (Pick <= vTotPicks) then
  1264.    begin
  1265.       W := pred(Pick) * succ(vStrLength);
  1266.       ArrayOffset := Ofs(vArrayPtr^) + W;
  1267.       Move(Mem[Seg(vArrayPtr^):ArrayOffset],TempStr,1);
  1268.       Move(Mem[Seg(vArrayPtr^):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  1269.    end
  1270.    else
  1271.       TempStr := '';
  1272.    W := vBorder.X2 - succ(vBorder.X1);
  1273.    GetString := Padleft(TempStr,W,' ');
  1274. end; {ArrayIOOBJ.GetString}
  1275.  
  1276. destructor ArrayIOOBJ.Done;
  1277. {}
  1278. begin
  1279.    ListIOOBJ.Done;
  1280. end; {ArrayIOOBJ.Done}
  1281. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1282. {                                                }
  1283. {     L i s t F i e l d O B J   M E T H O D S    }
  1284. {                                                }
  1285. {||||||||||||||||||||||||||||||||||||||||||||||||}
  1286. constructor LinkIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  1287. {}
  1288. begin
  1289.    ListIOOBJ.Init(X1,Y1,width,depth,Title);
  1290. end; {LinkIOOBJ.Init}
  1291.  
  1292. procedure LinkIOOBJ.AssignList(var LinkList: DLLOBJ);
  1293. {}
  1294. begin
  1295.    vLinkList := @LinkList;
  1296.    vTotPicks := LinkList.TotalNodes;
  1297.    vListAssigned := true;
  1298. end;  {LinkIOOBJ.AssignList}
  1299.  
  1300. function LinkIOOBJ.GetString(Pick:integer): string;
  1301. {}
  1302. var
  1303.   TempPtr : DLLNodePtr;
  1304. begin
  1305.    TempPtr := vLinkList^.NodePtr(Pick);
  1306.    if TempPtr <> Nil then
  1307.       vLinkList^.ShiftActiveNode(TempPtr,Pick);
  1308.    GetString := vLinkList^.GetStr(TempPtr,1,vBorder.X2 - vBorder.X1);
  1309. end; {LinkIOOBJ.GetString}
  1310.  
  1311. destructor LinkIOOBJ.Done;
  1312. {}
  1313. begin
  1314.    ListIOOBJ.Done;
  1315. end; {LinkIOOBJ.Done}
  1316. {||||||||||||||||||||||||||||||||||||||||}
  1317. {                                        }
  1318. {     I n t I O O B J   M E T H O D S    }
  1319. {                                        }
  1320. {||||||||||||||||||||||||||||||||||||||||}
  1321. constructor IntIOOBJ.Init(X,Y,Len:byte);
  1322. {}
  1323. begin
  1324.    CharIOOBJ.Init(X,Y,Len);
  1325.    vMin := 0;
  1326.    vMax := 0;
  1327.    vFmtPtr := Nil;
  1328. end; {IntIOOBJ.Init}
  1329.  
  1330. function IntIOOBJ.FormatPtr: pFmtNumberOBJ;
  1331. {}
  1332. begin
  1333.    FormatPtr := vFmtPtr;
  1334. end; {IntIOOBJ.FormatPtr}
  1335.  
  1336. procedure IntIOOBJ.InitFormat;
  1337. {}
  1338. begin
  1339.    if vFmtPtr <> nil then
  1340.       Dispose(vFmtPtr,Done);
  1341.    new(vFmtPtr,Init);
  1342.    vFmtPtr^ := FmtNumberTOT;
  1343. end; {IntIOOBJ.InitFormat}
  1344.  
  1345. procedure IntIOOBJ.SetMinMax(Min,Max:longint);
  1346. {}
  1347. begin
  1348. {$IFDEF CHECK}
  1349.    if Min > Max then
  1350.    begin
  1351.      vMax := Min;
  1352.      vMin := Max;
  1353.    end
  1354.    else
  1355.    begin
  1356.      vMax := Max;
  1357.      vMin := Min;
  1358.    end;
  1359. {$ELSE}
  1360.    vMax := Max;
  1361.    vMin := Min;
  1362. {$ENDIF}
  1363. end; {IntIOOBJ.SetMinMax}
  1364.  
  1365. procedure IntIOOBJ.SetValue(Val:longint);
  1366. {}
  1367. begin
  1368.    if  ((vRules and SuppressZero) = SuppressZero)
  1369.    and (Val = 0) then
  1370.       vInputStr := ''
  1371.    else
  1372.       vInputStr := IntToStr(Val);
  1373.    InitCursor;  {1.00n}
  1374. {$IFDEF CHECK}
  1375.    if VMax <> vMin then
  1376.    begin
  1377.       if Val < vMin then
  1378.          vMin := Val
  1379.       else if Val > vMax then
  1380.       begin
  1381.          vMax := Val;
  1382.          vMaxLen := length(IntToStr(vMax));
  1383.       end;
  1384.    end;
  1385. {$ENDIF}
  1386. end;  {IntIOOBJ.SetValue}
  1387.  
  1388. function IntIOOBJ.GetValue:longint;
  1389. {}
  1390. begin
  1391.    if ValidInt(vInputStr) then
  1392.       GetValue := StrToLong(vInputStr)
  1393.    else
  1394.       GetValue := 0;
  1395. end;  {IntIOOBJ.GetValue}
  1396.  
  1397. function IntIOOBJ.CharOK(var Ch:char):boolean;
  1398. {}
  1399. begin
  1400.    if (Ch = '+') and ((pos('+',vInputStr)>0) or (vCursorStr > 1))
  1401.    or (Ch = '-') and ((pos('-',vInputStr)>0) or (vCursorStr > 1)) then
  1402.       CharOK := false
  1403.    else
  1404.       CharOK :=    (Ch in  ['0'..'9'])
  1405.              or (  (Ch='-') and ((vMin=vMax) or (vMin < 0)))
  1406.              or (  (Ch='+') and ((vMin=vMax) or (vMax > 0)))
  1407. end; {IntIOOBJ.CharOK}
  1408.  
  1409. procedure IntIOOBJ.ReDisplay(Status:tStatus);
  1410. {}
  1411. var
  1412.   A: byte;
  1413.   AdjStr: String;
  1414.   L: longint;
  1415. begin
  1416.    if (Status = Norm)  then              {1.00d}
  1417.    begin
  1418.       if (vFmtPtr <> Nil) then
  1419.       begin
  1420.          L := GetValue;
  1421.          Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1422.                         IOTOT^.FieldCol(1),
  1423.                         vFmtPtr^.FormattedLong(L,vMaxLen));
  1424.       end
  1425.       else
  1426.       begin
  1427.          AdjStr := vInputStr;
  1428.          AdjStr := Pad(vJust,AdjStr,vFieldLen,vPad);
  1429.          Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1430.                         IOTOT^.FieldCol(1),AdjStr);
  1431.       end;
  1432.    end
  1433.    else
  1434.    begin
  1435.       AdjStr := vInputStr;
  1436.       SetFieldAttr(Status,A,AdjStr);
  1437.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
  1438.    end;
  1439. end; {IntIOOBJ.ReDisplay}
  1440.  
  1441. function IntIOOBJ.Suspend:boolean;
  1442. {}
  1443. var
  1444.   L : longint;
  1445. begin
  1446.    L := GetValue;
  1447.    if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  1448.    and (vMax <> vMin)
  1449.    and ((ValidInt(vInputStr) = false) or (L > vMax) or (L < vMin))
  1450.    then   {Invalid}
  1451.    begin
  1452.       ValidationMessage(NumberError[1],
  1453.                         NumberError[2],
  1454.                         '',
  1455.                         IntToStr(vMin)+' - '+IntToStr(vMax));
  1456.       Suspend := false;
  1457.       vFirstKey := true;
  1458.    end
  1459.    else
  1460.    begin
  1461.       ReDisplay(Norm);
  1462.       WriteLabel(Norm);
  1463.       ClearMessage;
  1464.       Suspend := true;
  1465.    end;
  1466. end; {IntIOOBJ.Suspend}
  1467.  
  1468. destructor IntIOOBJ.Done;
  1469. {}
  1470. begin
  1471.    CharIOOBJ.Done;
  1472.    if vFmtPtr <> nil then
  1473.       Dispose(vFmtPtr,Done);
  1474. end; {IntIOOBJ.Done}
  1475. {||||||||||||||||||||||||||||||||||||||||||}
  1476. {                                          }
  1477. {     R e a l I O O B J   M E T H O D S    }
  1478. {                                          }
  1479. {||||||||||||||||||||||||||||||||||||||||||}
  1480. constructor RealIOOBJ.Init(X,Y,Len:byte);
  1481. {}
  1482. begin
  1483.    CharIOOBJ.Init(X,Y,Len);
  1484.    vENotation := false;
  1485.    vMax := 0;
  1486.    vMin := 0;
  1487.    vFmtPtr := Nil;
  1488. end; {RealIOOBJ.Init}
  1489.  
  1490. function RealIOOBJ.FormatPtr: pFmtNumberOBJ;
  1491. {}
  1492. begin
  1493.    FormatPtr := vFmtPtr;
  1494. end; {RealIOOBJ.FormatPtr}
  1495.  
  1496. procedure RealIOOBJ.InitFormat;
  1497. {}
  1498. begin
  1499.    if vFmtPtr <> nil then
  1500.       Dispose(vFmtPtr,Done);
  1501.    new(vFmtPtr,Init);
  1502.    vFmtPtr^ := FmtNumberTOT;
  1503. end; {RealIOOBJ.InitFormat}
  1504.  
  1505. procedure RealIOOBJ.SetMinMax(Min,Max:extended);
  1506. {}
  1507. begin
  1508. {$IFDEF CHECK}
  1509.    if Min > Max then
  1510.    begin
  1511.      vMax := Min;
  1512.      vMin := Max;
  1513.    end
  1514.    else
  1515.    begin
  1516.      vMax := Max;
  1517.      vMin := Min;
  1518.    end;
  1519. {$ELSE}
  1520.    vMax := Max;
  1521.    vMin := Min;
  1522. {$ENDIF}
  1523. end; {RealIOOBJ.SetMinMax}
  1524.  
  1525. procedure RealIOOBJ.SetValue(Val:extended);
  1526. {}
  1527. begin
  1528.    if  ((vRules and SuppressZero) = SuppressZero)
  1529.    and (Val = 0.0) then
  1530.       vInputStr := ''
  1531.    else
  1532.    begin
  1533.       if vENotation then                                     {1.00m}
  1534.          vInputStr := RealtoSciStr(Val,Decimals(vFieldLen))
  1535.       else
  1536.          vInputStr := copy(RealToStr(Val,Floating),1,vFieldLen);
  1537.    end;
  1538.    InitCursor;  {1.00n}
  1539. {$IFDEF CHECK}
  1540.    if vMax <> vMin then
  1541.    begin
  1542.       if Val < vMin then
  1543.          vMin := Val
  1544.       else if Val > vMax then
  1545.          vMax := Val;
  1546.    end;
  1547. {$ENDIF}
  1548. end;  {RealIOOBJ.SetValue}
  1549.  
  1550. function RealIOOBJ.GetValue:extended;
  1551. {}
  1552. begin
  1553.    if ValidReal(vInputStr) then
  1554.       GetValue := StrToReal(vInputStr)
  1555.    else
  1556.       GetValue := 0;
  1557. end;  {RealIOOBJ.GetValue}
  1558.  
  1559. procedure RealIOOBJ.SetENotation(On:Boolean);
  1560. {}
  1561. begin
  1562.    vEnotation := On;
  1563. end; {RealIOOBJ.SetENotation}
  1564.  
  1565. function RealIOOBJ.CharOK(var Ch:char):boolean;
  1566. {}
  1567. var DC : char;
  1568. begin
  1569.    DC := FmtNumberTOT.GetDecimal;
  1570.    if ((Ch = DC) and (pos(DC,vInputStr)>0)) 
  1571.    or ((Ch = '-') and (pos('-',vInputStr)>0) and (vENotation=false))
  1572.    or ((Ch = '+') and (pos('+',vInputStr)>0))
  1573.    then
  1574.       CharOK := false
  1575.    else
  1576.       CharOK :=    (Ch in  ['0'..'9','+',DC])
  1577.                 or (  (Ch in ['E','e']) and vENotation)
  1578.                 or (  (Ch='-') and ((vMin=vMax) or (vMin < 0) or vENotation))    {1.00a}
  1579.                 or (  (Ch='+') and ((vMin=vMax) or (vMax > 0)));
  1580. end; {RealIOOBJ.CharOK}
  1581.  
  1582. procedure RealIOOBJ.ReDisplay(Status:tStatus);
  1583. {}
  1584. var
  1585.   A: byte;
  1586.   AdjStr: String;
  1587.   E: extended;
  1588. begin
  1589.    if (Status = Norm) then
  1590.    begin
  1591.       if (vFmtPtr <> Nil) then
  1592.       begin
  1593.          E := GetValue;
  1594.          Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1595.                         IOTOT^.FieldCol(1),
  1596.                         vFmtPtr^.FormattedReal(E,Floating,vMaxLen))
  1597.       end
  1598.       else
  1599.       begin
  1600.          AdjStr := vInputStr;
  1601.          AdjStr := Pad(vJust,AdjStr,vFieldLen,vPad);
  1602.          Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1603.                         IOTOT^.FieldCol(1),AdjStr);
  1604.       end;
  1605.    end
  1606.    else
  1607.    begin
  1608.       AdjStr := vInputStr;
  1609.       SetFieldAttr(Status,A,AdjStr);
  1610.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,padleft(vInputStr,vMaxlen,vPad));
  1611.    end;
  1612. end; {RealIOOBJ.ReDisplay}
  1613.  
  1614. function RealIOOBJ.Suspend:boolean;
  1615. {}
  1616. var
  1617.   E : extended;
  1618.   MsgStr: string;
  1619. begin
  1620.    E := GetValue;
  1621.    if  (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  1622.    and (vMax <> vMin)
  1623.    and ((ValidReal(vInputStr) = false) or (E > vMax) or (E < vMin))
  1624.    then   {Invalid}
  1625.    begin
  1626.       if vENotation then
  1627.          MsgStr := RealtoSciStr(vMin,Floating)+' - '+RealtoSciStr(vMax,Floating)
  1628.       else
  1629.          MsgStr := RealToStr(vMin,Floating)+' - '+RealToStr(vMax,Floating);
  1630.       ValidationMessage(NumberError[1],
  1631.                         NumberError[2],
  1632.                         '',
  1633.                         MsgStr);
  1634.       Suspend := false;
  1635.    end
  1636.    else
  1637.    begin
  1638.       ReDisplay(Norm);
  1639.       WriteLabel(Norm);
  1640.       ClearMessage;
  1641.       Suspend := true;
  1642.    end;
  1643. end; {RealIOOBJ.Suspend}
  1644.  
  1645. destructor RealIOOBJ.Done;
  1646. {}
  1647. begin
  1648.    CharIOOBJ.Done;
  1649.    if vFmtPtr <> nil then
  1650.       Dispose(vFmtPtr,Done);
  1651. end; {RealIOOBJ.Done}
  1652.  
  1653. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1654. {                                                    }
  1655. {     F i x e d R e a l I O O B J   M E T H O D S    }
  1656. {                                                    }
  1657. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  1658. constructor FixedRealIOOBJ.Init(X,Y,Whole,DP:byte);
  1659. {}
  1660. begin
  1661.    SingleLineIOOBJ.Init;
  1662.    vMax := 0;
  1663.    vMin := 0;
  1664.    vDP := DP;
  1665.    vWholeP := Whole;
  1666.    if vDP > 0 then
  1667.       vMaxlen := succ(vWholeP) + vDP
  1668.    else
  1669.       vMaxlen := vWholeP;
  1670.    vBoundary.X1 := X;
  1671.    vBoundary.X2 := pred(vBoundary.X1 + vMaxlen);
  1672.    vBoundary.Y1 := Y;
  1673.    vBoundary.Y2 := vBoundary.Y1;
  1674.    vCursorPos := 1;
  1675.    vPad := ' ';
  1676.    vWholeStr:= replicate(vWholeP,vPad);
  1677.    vDPStr :=  replicate(vDP,vPad);
  1678.    vFmtPtr := Nil;
  1679. end; {FixedRealIOOBJ.Init}
  1680.  
  1681. function FixedRealIOOBJ.IsNull:boolean; {1.00h}
  1682. {}
  1683. begin
  1684.    IsNull := (vWholeStr = replicate(vWholeP,vPad))
  1685.              and
  1686.              (vDPStr =  replicate(vDP,vPad));
  1687. end; {FixedRealIOOBJ.IsNull}
  1688.  
  1689. procedure FixedRealIOOBJ.SetNull;   {1.00j}
  1690. {}
  1691. begin
  1692.    vCursorPos := 1;
  1693.    vWholeStr:= replicate(vWholeP,vPad);
  1694.    vDPStr :=  replicate(vDP,vPad);
  1695. end; {FixedRealIOOBJ.SetNull}
  1696.  
  1697. function FixedRealIOOBJ.FormatPtr: pFmtNumberOBJ;
  1698. {}
  1699. begin
  1700.    FormatPtr := vFmtPtr;
  1701. end; {FixedRealIOOBJ.FormatPtr}
  1702.  
  1703. procedure FixedRealIOOBJ.InitFormat;
  1704. {}
  1705. begin
  1706.    if vFmtPtr <> nil then
  1707.       Dispose(vFmtPtr,Done);
  1708.    New(vFmtPtr,Init);
  1709.    vFmtPtr^ := FmtNumberTOT;
  1710. end; {FixedRealIOOBJ.InitFormat}
  1711.  
  1712. procedure FixedRealIOOBJ.SetMinMax(Min,Max:extended);
  1713. {}
  1714. begin
  1715. {$IFDEF CHECK}
  1716.    if Min > Max then
  1717.    begin
  1718.      vMax := Min;
  1719.      vMin := Max;
  1720.    end
  1721.    else
  1722.    begin
  1723.      vMax := Max;
  1724.      vMin := Min;
  1725.    end;
  1726. {$ELSE}
  1727.    vMax := Max;
  1728.    vMin := Min;
  1729. {$ENDIF}
  1730. end; {FixedRealIOOBJ.SetMinMax}
  1731.  
  1732. procedure FixedRealIOOBJ.SetValue(Val:extended);
  1733. {}
  1734. var
  1735.   TempStr : string;
  1736.   P : Byte;
  1737. begin
  1738.    vDPStr := replicate(vDP,vPad);
  1739.    if ((vRules and SuppressZero) = SuppressZero)
  1740.    and (Val = 0.0) then
  1741.       vWholeStr := replicate(vWholeP,vPad)
  1742.    else
  1743.    begin
  1744.      TempStr := RealToStr(Val,vDP);
  1745.      P := Pos('.',TempStr);
  1746.      if (P = 0) or (vDP = 0) then
  1747.         vWholeStr := padright(TempStr,vWholeP,vPad)
  1748.      else
  1749.      begin
  1750.         vWholeStr := padright(copy(TempStr,1,pred(P)),vWholeP,vPad);
  1751.         vDPStr := padleft(copy(TempStr,succ(P),vDP),vDP,vPad);
  1752.      end;
  1753.    end;
  1754.    vCursorPos := 1;     {1.00n}
  1755.    MoveCursor;
  1756. {$IFDEF CHECK}
  1757.    if vMin <> vMax then
  1758.    begin
  1759.       if Val < vMin then
  1760.          vMin := Val
  1761.       else if Val > vMax then
  1762.          vMax := Val;
  1763.    end;
  1764. {$ENDIF}
  1765. end;  {FixedRealIOOBJ.SetValue}
  1766.  
  1767. procedure FixedRealIOOBJ.Condense;
  1768. {}
  1769. begin
  1770.    if vWholeStr [1] = '-' then
  1771.    begin
  1772.       delete(vWholeStr,1,1);
  1773.       vWholeStr := '-'+padright(Strip('A',vPad,vWholeStr),pred(vWholeP),vPad);
  1774.    end
  1775.    else
  1776.       vWholeStr := padright(Strip('A',vPad,vWholeStr),vWholeP,vPad);
  1777.    vDPStr := padleft(Strip('A',vPad,vDPStr),vDP,'0');
  1778. end; {FixedRealIOOBJ.Condense}
  1779.  
  1780. function FixedRealIOOBJ.GetValue:extended;
  1781. {}
  1782. var ValStr: string;
  1783. begin
  1784.    Condense;
  1785.    ValStr := vWholeStr+'.'+vDPStr;
  1786.    ValStr := strip('A',vPad,ValStr);
  1787.    if ValidReal(ValStr) then
  1788.       GetValue := StrToReal(ValStr)
  1789.    else
  1790.       GetValue := 0;
  1791. end;  {FixedRealIOOBJ.GetValue}
  1792.  
  1793. procedure FixedRealIOOBJ.PeriodHit;
  1794. {}
  1795. begin
  1796.    Condense;
  1797.    if vDP > 0 then
  1798.       vCursorPos := vWholeP + 2
  1799.    else
  1800.       vCursorPos := vWholeP;
  1801.    Display(HiStatus);
  1802. end; {FixedRealIOOBJ.PeriodHit}
  1803.  
  1804. procedure FixedRealIOOBJ.PlusHit;
  1805. {}
  1806. var P: byte;
  1807. begin
  1808.    if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then {1.00g}
  1809.       Erase;
  1810.    P := pos('-',vWholeStr);
  1811.    if P > 0 then
  1812.    begin
  1813.       delete(vWholeStr,P,1);
  1814.       insert(vPad,vWholeStr,P);
  1815.       Display(HiStatus);
  1816.    end;
  1817. end; {FixedRealIOOBJ.PlusHit}
  1818.  
  1819. procedure FixedRealIOOBJ.MinusHit;
  1820. {}
  1821. var P: byte;
  1822. begin
  1823.    if (vMin >= 0.0) and (vMin <> vMax) then   {1.00a}
  1824.       ding
  1825.    else
  1826.    begin
  1827.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then {1.00g}
  1828.          Erase;
  1829.       P := pos('-',vWholeStr);
  1830.       if P = 0 then
  1831.       begin
  1832.          P := pos(vPad,vWholeStr);
  1833.          if P = 0 then
  1834.             ding
  1835.          else
  1836.          begin
  1837.             delete(vWholeStr,P,1);
  1838.             vWholeStr := '-'+vWholeStr;
  1839.          end;
  1840.          Display(HiStatus);
  1841.          if vCursorPos = 1 then
  1842.             CursorRight;
  1843.       end;
  1844.    end;
  1845. end; {FixedRealIOOBJ.MinusHit}
  1846.  
  1847. procedure FixedRealIOOBJ.CursorHome;
  1848. {}
  1849. begin
  1850.    vCursorPos := 1;
  1851.    Display(HiStatus);
  1852. end; {FixedRealIOOBJ.CursorHome}
  1853.  
  1854. procedure FixedRealIOOBJ.CursorEnd;
  1855. {}
  1856. begin
  1857.    vCursorPos := vMaxlen;
  1858. end; {FixedRealIOOBJ.CursorEnd}
  1859.  
  1860. procedure FixedRealIOOBJ.CursorLeft;
  1861. {}
  1862. begin
  1863.    if vCursorPos > 1 then
  1864.       dec(vCursorPos);
  1865.    if (vCursorPos = succ(vWholeP)) then
  1866.       dec(vCursorPos);
  1867. end; {FixedRealIOOBJ.CursorLeft}
  1868.  
  1869. procedure FixedRealIOOBJ.CursorRight;
  1870. {}
  1871. begin
  1872.    if vCursorPos < vMaxlen then
  1873.       inc(vCursorPos);
  1874.    if (vCursorPos = succ(vWholeP)) then
  1875.       inc(vCursorPos);
  1876. end; {FixedRealIOOBJ.CursorRight}
  1877.  
  1878. procedure FixedRealIOOBJ.Erase;
  1879. {}
  1880. begin
  1881.    SetNull;
  1882.    Display(HiStatus);
  1883. end; {FixedRealIOOBJ.Erase}
  1884.  
  1885. procedure FixedRealIOOBJ.DeleteChar;
  1886. {}
  1887. var P : byte;
  1888. begin
  1889.   if vCursorPos  <= vWholeP then
  1890.   begin
  1891.      P := vCursorPos-(vWholeP-length(vWholeStr));
  1892.      delete(vWholeStr,P,1);
  1893.      insert(vPad,vWholeStr,P);
  1894.   end
  1895.   else
  1896.   begin
  1897.      P := vCursorPos - succ(vWholeP);
  1898.      delete(vDPStr,P,1);
  1899.      insert(vPad,vDPStr,P);
  1900.   end;
  1901.   Display(HiStatus);
  1902. end; {FixedRealIOOBJ.DeleteChar}
  1903.  
  1904. procedure FixedRealIOOBJ.BackSpace;
  1905. {}
  1906. begin
  1907.    if vCursorPos > 1 then
  1908.    begin
  1909.       CursorLeft;
  1910.       DeleteChar;
  1911.       Display(HiStatus)
  1912.    end;
  1913. end; {FixedRealIOOBJ.BackSpace}
  1914.  
  1915. function FixedRealIOOBJ.ProcessEnter:tAction;
  1916. {}
  1917. begin
  1918.  
  1919.    ProcessEnter := Enter;
  1920. end; {FixedRealIOOBJ.ProcessEnter}
  1921.  
  1922. procedure FixedRealIOOBJ.MoveCursor;
  1923. {}
  1924. begin
  1925.    Screen.GotoXY(pred(vBoundary.X1)+vCursorPos,vBoundary.Y1);
  1926. end; {FixedRealIOOBJ.MoveCursor}
  1927.  
  1928. procedure FixedRealIOOBJ.Display(Status:tStatus);
  1929. {}
  1930. var
  1931.   A: byte;
  1932.   AdjStr: String;
  1933.   E: Extended;
  1934. begin
  1935.    if (Status <> HiStatus) and (vFmtPtr <> nil) then
  1936.    begin
  1937.       E := GetValue;
  1938.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,
  1939.                      IOTOT^.FieldCol(1),
  1940.                      vFmtPtr^.FormattedReal(E,vDP,vMaxLen))
  1941.    end
  1942.    else
  1943.    begin
  1944.       AdjStr := vWholeStr;
  1945.       if vDP > 0 then
  1946.          AdjStr := AdjStr + FmtNumberTOT.GetDecimal+vDPStr;
  1947.       SetFieldAttr(Status,A,AdjStr);
  1948.       Screen.WriteAt(vBoundary.X1,vBoundary.Y1,A,AdjStr);
  1949.    end;
  1950. end; {FixedRealIOOBJ.Display}
  1951.  
  1952. procedure FixedRealIOOBJ.ProcessChar(Ch:char);
  1953. {}
  1954. var
  1955.   P,WholePos,DPPos: byte;
  1956.  
  1957.    procedure EraseOld;
  1958.    {}
  1959.    begin
  1960.       if vFirstKey and ((vRules and EraseDefault) = EraseDefault) then
  1961.          Erase;
  1962.    end; {EraseOld}
  1963.  
  1964. begin
  1965.    if Ch in ['0'..'9'] then
  1966.       EraseOld
  1967.    else
  1968.    begin
  1969.       Ding;
  1970.       exit
  1971.    end;
  1972.    WholePos := vCursorPos-(vWholeP-length(vWholeStr));
  1973.    if vCursorPos > vWholeP then  {entering decimals}
  1974.       DPPos := vCursorPos - succ(vWholeP)
  1975.    else
  1976.       DPPos := 0;
  1977.    if not vInsert then
  1978.    begin
  1979.       if DPPOS > 0 then  {entering decimals}
  1980.       begin
  1981.          delete(vDPStr,DPPos,1);
  1982.          insert(Ch,vDPStr,DPPos);
  1983.       end
  1984.       else  {entering whole numbers}
  1985.       begin
  1986.          delete(vWholeStr,WholePos,1);
  1987.          insert(Ch,vWholeStr,WholePos);
  1988.       end;
  1989.    end
  1990.    else
  1991.    begin
  1992.       if DPPos > 0 then  {entering decimals}
  1993.       begin
  1994.          if vDPStr[DPPos] = vPad then
  1995.          begin
  1996.             delete(vDPStr,DPPos,1);
  1997.             insert(Ch,vDPStr,DPPos);
  1998.          end
  1999.          else
  2000.          begin
  2001.             P := PosAfter(vPad,vDPStr,DPPos);
  2002.             if P = 0 then   {push a character off the end}
  2003.                delete(vDPStr,length(vDPStr),1)
  2004.             else
  2005.                delete(vDPStr,P,1);
  2006.             insert(Ch,vDPStr,DPPos);
  2007.          end;
  2008.       end
  2009.       else  {entering whole numbers}
  2010.       begin
  2011.          if vWholeStr[WholePos] in [vPad,'-'] then
  2012.          begin
  2013.             delete(vWholeStr,WholePos,1);
  2014.             insert(Ch,vWholeStr,WholePos);
  2015.          end
  2016.          else
  2017.          begin
  2018.             P := LastPosBefore(vPad,vWholeStr,WholePos);
  2019.             if P = 0 then
  2020.                P := pos(vPad,vWholeStr);
  2021.             if P = 0 then   {no room for another character}
  2022.             begin
  2023.                Ding;
  2024.                exit;
  2025.             end
  2026.             else
  2027.             begin
  2028.                delete(vWholeStr,P,1);
  2029.                insert(Ch,vWholeStr,WholePos);
  2030.                if WholePos = vWholeP then
  2031.                begin
  2032.                   Display(HiStatus);  {don't cursor right}
  2033.                   exit;
  2034.                end;
  2035.             end;
  2036.          end;
  2037.       end;
  2038.    end;
  2039.    CursorRight;
  2040.    Display(HiStatus);
  2041. end; {FixedRealIOOBJ.ProcessChar}
  2042.  
  2043. function FixedRealIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  2044. {}
  2045. begin
  2046.    if InKey = ord(FmtNumberTOT.GetDecimal) then
  2047.       PeriodHit
  2048.    else
  2049.    Case InKey of
  2050.       8: BackSpace;
  2051.       339: DeleteChar;
  2052.       327: CursorHome;
  2053.       335: CursorEnd;
  2054.       331: CursorLeft;
  2055.       333: CursorRight;
  2056.       338: begin
  2057.               vInsert := not vInsert;
  2058.               InsertAction(vInsert);
  2059.            end;
  2060.       ord('+'): PlusHit;
  2061.       ord('-'): MinusHit;
  2062.       32..255: ProcessChar(chr(InKey));    {characters}
  2063.    end; {case}
  2064.    case InKey of
  2065.       13: ProcessKey := ProcessEnter;
  2066.       (* 1.00k
  2067.       27: ProcessKey := Escaped;
  2068.       *)
  2069.       else ProcessKey := None;
  2070.    end; {case}
  2071.    if (Inkey > 0) and (Inkey < 256) then  {1.00n,o}
  2072.       vFirstKey := false;
  2073.    MoveCursor;
  2074. end; {FixedRealIOOBJ.ProcessKey}
  2075.  
  2076. procedure FixedRealIOOBJ.Activate;
  2077. {}
  2078. var
  2079.    Action: tAction;
  2080. begin
  2081.    repeat
  2082.       Action := Select(0,0,0);
  2083.       Display(HiStatus);
  2084.       WriteLabel(HiStatus);
  2085.       with Key do
  2086.          repeat
  2087.             GetInput;
  2088.             if LastKey = 27 then  {1.00k}
  2089.                Action := Escaped
  2090.             else
  2091.                Action := ProcessKey(LastKey,LastX,LastY);
  2092.          until Action in [Finished,Escaped,Enter];
  2093.    until Suspend;
  2094. end; {FixedRealIOOBJ.Activate}
  2095.  
  2096. function FixedRealIOOBJ.Select(K:word; X,Y:byte): tAction;
  2097. {}
  2098. begin
  2099.    Display(HiStatus);
  2100.    WriteLabel(HiStatus);
  2101.    InsertAction(vInsert);
  2102.    WriteMessage;
  2103.    vFirstKey := true;
  2104.    if ((vRules and EraseDefault) = EraseDefault) then {1.00o}
  2105.       vCursorPos := 1;
  2106.    MoveCursor;
  2107.    Select := None;
  2108. end; {FixedRealIOOBJ.Select}
  2109.  
  2110. function FixedRealIOOBJ.Suspend:boolean;
  2111. {}
  2112. var Col,L: byte;
  2113.     ValStr: string;
  2114.     E : extended;
  2115. begin
  2116.    E := GetValue;
  2117.    Condense;
  2118.    ValStr := vWholeStr+'.'+vDPStr;
  2119.    ValStr := strip('A',vPad,ValStr);
  2120.    if  (((vRules and AllowNull) = AllowNull) and (getValue=0) = false)
  2121.    and (vMax <> vMin)
  2122.    and ((ValidReal(ValStr) = false) or (E > vMax) or (E < vMin))
  2123.    then   {Invalid}
  2124.    begin
  2125.       ValidationMessage(NumberError[1],
  2126.                         NumberError[2],
  2127.                         '',
  2128.                         RealToStr(vMin,vDP)+' - '+RealToStr(vMax,vDP));
  2129.       vFirstKey := true;
  2130.       Suspend := false;
  2131.    end
  2132.    else
  2133.    begin
  2134.       Display(Norm);
  2135.       WriteLabel(Norm);
  2136.       if vMsgPtr <> Nil then   {clear the message}
  2137.       begin
  2138.          move(vMsgPtr^,L,1);
  2139.          if L > 0 then
  2140.          begin
  2141.             Col := IOTOT^.MessageCol;
  2142.             if Col = 0 then
  2143.                Screen.WritePlain(vMsgX,vMsgY,replicate(L,' '))
  2144.             else
  2145.                Screen.WriteAt(vMsgX,vMsgY,Col,replicate(L,' '));
  2146.          end;
  2147.       end;
  2148.       Suspend := true;
  2149.    end;
  2150. end; {FixedRealIOOBJ.Suspend}
  2151.  
  2152. destructor FixedRealIOOBJ.Done;
  2153. {}
  2154. begin
  2155.    SingleLineIOOBJ.Done;
  2156.    if vFmtPtr <> nil then
  2157.       Dispose(vFmtPtr,Done);
  2158. end; {FixedRealIOOBJ.Done}
  2159. {||||||||||||||||||||||||||||||||||||||||||}
  2160. {                                          }
  2161. {     D a t e I O O B J   M E T H O D S    }
  2162. {                                          }
  2163. {||||||||||||||||||||||||||||||||||||||||||}
  2164. constructor DateIOOBJ.Init(X,Y:byte;DateFmt:tDate);
  2165. {}
  2166. var 
  2167.   Pic:string[10];
  2168.   Sep:char;
  2169. begin
  2170.    vDateFmt := DateFmt;
  2171.    Sep := DateTOT^.GetSeparator;
  2172.    Case vDateFmt of
  2173.       MMDDYY,
  2174.       DDMMYY,
  2175.       YYMMDD:   Pic := '##'+Sep+'##'+Sep+'##';
  2176.       MMDDYYYY,
  2177.       DDMMYYYY: Pic := '##'+Sep+'##'+Sep+'####';
  2178.       MMYY:     Pic := '##'+Sep+'##';
  2179.       MMYYYY:   Pic := '##'+Sep+'####';
  2180.       YYYYMMDD: Pic := '####'+Sep+'##'+Sep+'##';
  2181.    end; {case}
  2182.    PictureIOOBJ.Init(X,Y,Pic);
  2183.    vMin := 0;
  2184.    vMax := 0;
  2185. end; {DateIOOBJ.Init}
  2186.  
  2187. procedure DateIOOBJ.SetMinMax(Min,Max:longint);
  2188. {}
  2189. begin
  2190. {$IFDEF CHECK}
  2191.    if Min > Max then
  2192.    begin
  2193.      vMax := Min;
  2194.      vMin := Max;
  2195.    end
  2196.    else
  2197.    begin
  2198.      vMax := Max;
  2199.      vMin := Min;
  2200.    end;
  2201. {$ELSE}
  2202.    vMax := Max;
  2203.    vMin := Min;
  2204. {$ENDIF}
  2205. end; {DateIOOBJ.SetMinMax}
  2206.  
  2207. procedure DateIOOBJ.SetValue(Date:longint);
  2208. {}
  2209. begin
  2210.    PictureIOOBJ.Setvalue(StripDateStr(JultoStr(Date,vDateFmt),vDateFmt));
  2211. end; {DateIOOBJ.SetValue}
  2212.  
  2213. function DateIOOBJ.GetValue: longint;
  2214. {}
  2215. begin
  2216.    if vInputStr = '' then
  2217.       GetValue := StrToJul('01/01/1980',DDMMYYYY)
  2218.    else
  2219.       GetValue := StrtoJul(vInputStr,vDateFmt);
  2220. end; {DateIOOBJ.GetValue}
  2221.  
  2222. function DateIOOBJ.Suspend:boolean;
  2223. {}
  2224. var
  2225.   L : longint;
  2226.   OK : boolean;
  2227. begin
  2228.    L := GetValue;
  2229.    OK := ValidDateStr(vInputStr,vDateFmt);
  2230.    if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  2231.    and ( (OK = false)
  2232.          or ((vMax <> vMin) and ((L > vMax) or (L < vMin)))
  2233.        )
  2234.    then   {Invalid}
  2235.    begin
  2236.       if (OK = false) then
  2237.          ValidationMessage(DateError[1],
  2238.                            DateError[2],
  2239.                             '',
  2240.                             '      '+DateFormat(vDateFmt))
  2241.       else if (L < vMin) then
  2242.          ValidationMessage(DateError[3],
  2243.                            DateError[4],
  2244.                             '',
  2245.                             '   '+JulToStr(vMin,vDateFmt))
  2246.       else
  2247.          ValidationMessage(DateError[5],
  2248.                            DateError[6],
  2249.                             '',
  2250.                             '   '+JulToStr(vMax,vDateFmt));
  2251.       Suspend := false;
  2252.    end
  2253.    else
  2254.    begin
  2255.       ReDisplay(Norm);
  2256.       WriteLabel(Norm);
  2257.       ClearMessage;
  2258.       Suspend := true;
  2259.    end;
  2260. end; {DateIOOBJ.Suspend}
  2261.  
  2262. destructor DateIOOBJ.Done;
  2263. {}
  2264. begin
  2265.    PictureIOOBJ.Done;
  2266. end; {DateIOOBJ.Done}
  2267. {||||||||||||||||||||||||||||||||||||||||}
  2268. {                                        }
  2269. {     H E X I O O B J   M E T H O D S    }
  2270. {                                        }
  2271. {||||||||||||||||||||||||||||||||||||||||}
  2272. constructor HEXIOOBJ.Init(X,Y,Len:byte);
  2273. {}
  2274. begin
  2275.    PictureIOOBJ.Init(X,Y,replicate(len,'*'));
  2276.    SetAllowChar('0123456789aAbBcCdDeEfF');
  2277.    vMin := 0;
  2278.    vMax := 0;
  2279. end; {HEXIOOBJ.Init}
  2280.  
  2281. procedure HEXIOOBJ.SetMinMax(Min,Max:longint);
  2282. {}
  2283. begin
  2284. {$IFDEF CHECK}
  2285.    if Min > Max then
  2286.    begin
  2287.      vMax := Min;
  2288.      vMin := Max;
  2289.    end
  2290.    else
  2291.    begin
  2292.      vMax := Max;
  2293.      vMin := Min;
  2294.    end;
  2295. {$ELSE}
  2296.    vMax := Max;
  2297.    vMin := Min;
  2298. {$ENDIF}
  2299. end; {HEXIOOBJ.SetMinMax}
  2300.  
  2301. procedure HEXIOOBJ.SetValue(Val:longint);
  2302. {}
  2303. begin
  2304.    PictureIOOBJ.SetValue(InttoHEXStr(Val));
  2305. end; {HEXIOOBJ.SetValue}
  2306.  
  2307. function HEXIOOBJ.GetValue: longint;
  2308. {}
  2309. begin
  2310.    GetValue := HEXStrtoLong(vInputStr);
  2311. end; {HEXIOOBJ.GetValue}
  2312.  
  2313. function HEXIOOBJ.Suspend:boolean;
  2314. {}
  2315. var
  2316.   L : longint;
  2317. begin
  2318.    L := GetValue;
  2319.    if (((vRules and AllowNull) = AllowNull) and (vInputStr = '') = false)
  2320.    and (vMax <> vMin)
  2321.    and ((L > vMax) or (L < vMin))
  2322.    then   {Invalid}
  2323.    begin
  2324.       ValidationMessage(NumberError[1],
  2325.                         NumberError[2],
  2326.                         '',
  2327.                         IntToHEXStr(vMin)+' - '+IntToHEXStr(vMax));
  2328.       Suspend := false;
  2329.    end
  2330.    else
  2331.    begin
  2332.       ReDisplay(Norm);
  2333.       WriteLabel(Norm);
  2334.       ClearMessage;
  2335.       Suspend := true;
  2336.    end;
  2337. end; {HEXIOOBJ.Suspend}
  2338.  
  2339. destructor HEXIOOBJ.Done;
  2340. {}
  2341. begin
  2342.    PictureIOOBJ.Done;
  2343. end; {HEXIOOBJ.Done}
  2344. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2345. {                                               }
  2346. {     U N I T   I N I T I A L I Z A T I O N     }
  2347. {                                               }
  2348. {|||||||||||||||||||||||||||||||||||||||||||||||}
  2349. procedure IO2Init;
  2350. {initilizes objects and global variables}
  2351. begin
  2352.    FmtNumberTOT.Init;
  2353. end; {IO2Init}
  2354.  
  2355. {end of unit - add initialization routines below}
  2356. {$IFNDEF OVERLAY}
  2357. begin
  2358.    IO2Init;
  2359. {$ENDIF}
  2360. end.
  2361.